home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / intools.pas < prev    next >
Pascal/Delphi Source File  |  1985-06-03  |  4KB  |  146 lines
  1. { INTOOLS  -  Procedures and Functions for interactive input in Pascal
  2.   Copyright (c) 1984 by Ronald Florence    
  3.  
  4.   These procedures and functions were written to avoid the horrors of
  5.   "Data Format Error in file USER" crashes. The procedures will work
  6.   with IBM Pascal or MS-Pascal, and can be incorporately separately as
  7.   needed with {$include} metacommands. 
  8.  
  9.     RDREAL: reads a real number (positive or negative) in decimal format
  10.     RDINT: reads an integer (positive or negative) within a specified range
  11.     RDCHAR: reads a character in a specified set  (inkey)
  12.     NOMORE: prompts the user with 'More?' and reads a 'y' or 'n' (inkey)
  13.     YESNO: reads a 'y' or 'n' (inkey)
  14.  
  15.   Use the tools in 'repeat...until' loops. For example:
  16.       repeat
  17.           write ('Enter an integer between 0 and 10: ');
  18.       until rdint(0,10);
  19.   Include 'charset = set of char' as a type declaration when using RDCHAR    }
  20.  
  21.  
  22.  
  23. function rdreal (var  r: real): boolean;
  24.     const    bell = chr (7);
  25.     var   decimal, left, right: real;
  26.           neg: boolean;
  27. begin
  28.     left:= 0;
  29.     decimal:= 1;
  30.     right:= 0;
  31.     neg:= false;
  32.     while not eoln and not (input^ in [chr(33)..chr(255)]) do get (input);
  33.     neg:= input^ = chr(45);
  34.     if neg then get (input);
  35.     rdreal:= input^ in ['0'..'9'];
  36.     while input^ in ['0'..'9'] do begin;
  37.         left:= left * 10 + ord (input^) - ord ('0');
  38.         get (input);
  39.     end;
  40.     if input^ = chr(46) then begin
  41.         get (input);
  42.         while input^ in ['0'..'9'] do begin
  43.             right:= right + decimal * (ord (input^) - ord ('0')) / 10;
  44.             decimal:= decimal / 10;
  45.             get (input);
  46.         end;
  47.     end;
  48.     r:= left + right;
  49.     if neg then r:= - r;
  50.     if input^ in [chr(33)..chr(44), chr(47), chr(58)..chr(255)] then begin
  51.         rdreal:= false;
  52.         write (bell);
  53.     end;
  54.     readln;
  55. end;
  56.  
  57.  
  58. function rdint (var  i:integer; low,high:integer): boolean;
  59.     const   bell = chr (7);
  60.     var   neg: boolean;
  61. begin
  62.     i:= 0;
  63.     neg:= false;
  64.     while not eoln and not (input^ in [chr(33)..chr(255)]) do get (input);
  65.     neg:= input^ = chr(45);
  66.     if neg then get (input);
  67.     while input^ in ['0'..'9'] do begin
  68.         i:= i * 10 + ord (input^) - ord ('0');
  69.         get (input);
  70.     end;
  71.     if neg then i:= - i;
  72.     if (input^ in [chr(33)..chr(44), chr(46), chr(47), chr(58)..chr(255)]) or
  73.         (eoln and ((i < low) or (i > high))) then begin
  74.             rdint:= false;
  75.             write (bell);
  76.     end
  77.     else rdint:= (i >= low) and (i <= high);
  78.     readln;
  79. end;
  80.  
  81.  
  82. function rdchar (okchars: charset): char;
  83. var   f, g: file of char;
  84.       c: char;
  85. function inkey: char;
  86.     begin
  87.         repeat get (f) until f^ <> chr (0);
  88.         inkey:= f^;
  89.     end;
  90. begin
  91.     assign (f, 'user');
  92.     reset (f);
  93.     assign (g, 'user');
  94.     rewrite (g);
  95.     repeat
  96.         c:= inkey;
  97.         if not (c in okchars) then if c in ['A'..'Z'] then
  98.             c:= chr (ord(c) - ord('A') + ord('a'))
  99.         else if c in ['a'..'z'] then c:= chr (ord(c) - ord('a') + ord('A'));
  100.     until c in okchars;
  101.     write (g, c);
  102.     writeln;
  103.     rdchar:= c;
  104. end;
  105.  
  106.  
  107. function nomore: boolean;
  108. var   f, g: file of char;
  109.       c: char;
  110. function inkey: char;
  111.     begin
  112.         repeat get (f) until f^ <> chr (0);
  113.         inkey:= f^;
  114.     end;
  115. begin
  116.     write ('More? ');
  117.     assign (f, 'user');
  118.     reset (f);
  119.     assign (g, 'user');
  120.     rewrite (g);
  121.     repeat c:= inkey until c in ['y','Y','n','N'];
  122.     write (g, c);
  123.     writeln;
  124.     nomore:= c in ['n', 'N']
  125. end;
  126.  
  127.  
  128. function yes: boolean;
  129. var   f, g: file of char;
  130.       c: char;
  131. function inkey: char;
  132.     begin
  133.         repeat get (f) until f^ <> chr (0);
  134.         inkey:= f^;
  135.     end;
  136. begin
  137.     assign (f, 'user');
  138.     reset (f);
  139.     assign (g, 'user');
  140.     rewrite (g);
  141.     repeat c:= inkey until c in ['y','Y','n','N'];
  142.     write (g,c);
  143.     writeln;
  144.     yes:= c in ['y', 'Y'];
  145. end;
  146.